Celem analizy jest znalezienie i interpretacja czynników wpływających na dobrobyt w państwie.
Na rok 2018 według Międzynarodowego Funduszu Walutowego największą gospodarką świata są Stany Zjednoczone. Na rozwój tak dużej gospodarki ma wpływ wiele czynników. Drugą gospodarką są Chiny. Z tego względu zostały przeanalizowane wskaźniki dobrobytu Stanów Zjednoczonych i wpływ Chińskiego Yuan. Dodatkowo analiza obejmuje cenę złota, bitcoina, oraz dane o indeksie S&P Composite. Dane zostały zebrane głównie przez Bank Światowy.
Dane zostały pogrupowane względem roku. Ze względu na ograniczony przedział danych o kursie Yuan analiza obejmuje lata 1995 - 2018. Początkowy zbiór posiadła dużo atrybutów powodujących duży szum. Aby temu zaradzić atrybuty zostały odrzucone ze względu na brak danych, bądź podobieństwo (np. wzrost populacji jest podobny do wzrostu ludności miejskiej).
Taki zbiór został poddany analizie korelacji. Obserwacją na którą warto zwrócić uwagą to zależność między spadkiem emisji CO2 i ceny Yuan, a wzrostem ceny złota. Ciekawą obeserwacją jest brak wpływu wzrostu ceny Bitcoina na cenę złota. Sugeruje to, że waluta wirtualna nie jest odwzorowaniem faktycznego stanu rynku finansowego.
Ostatnim elementem analizy jest sekcja próbująca przewidzieć cenę złota z wykorzystaniem algorytmu uczenia maszynowego Random Forest. W tej sekcji można zaobserwować, że największy wpływ na to mają czynniki takie jak: stopa procentowa indeksu S&P Composite, emisja CO2, wskaźnik cen towarów i usług konsumpcyjnych, czy populacja zamieszkująca miasta.
library(EDAWR)
library(dplyr)
library(tidyr)
library(ggplot2)
library(readxl)
library(zoo)
library(tibble)
library(plotly)
library(caret)
library(gganimate)
library(randomForest)
World_Development_Indicators <- read_excel("Data pack/World_Development_Indicators.xlsx")
SP_Composite <- read.table("Data pack/S&P Composite.csv", sep = ",", header = TRUE)
Gold_prices <- read.csv("Data pack/Gold prices.csv")
Bitcoin_diff <- read.csv("Data pack/Bitcoin/BCHAIN-DIFF.csv") # diff to jest trudność wydobycia
Bitcoin_hrate <- read.csv("Data pack/Bitcoin/BCHAIN-HRATE.csv") # liczba tera hashy wykonanych
Bitcoin_mkpru <- read.csv("Data pack/Bitcoin/BCHAIN-MKPRU.csv") # średnia wartość rynkowa
Bitcoin_trvou <- read.csv("Data pack/Bitcoin/BCHAIN-TRVOU.csv") # całkowita wartość bitcoinów
Currency_Exchange_Rates <- read.csv("Data pack/CurrencyExchangeRates.csv")
Niniejsza sekcja poświęcona jest czyszczeniu i transformacji danych z dostępnych zbiorów.
Zbiór zawiera dane o kursach walut. Dane pochodzą z lat 1995, 2018, co ogranicza nam pozostałe zbiory do podanego okresu. Brakujące dane zostaną interpolowane. Walutą która zostanie poddane analizie będzie Chiński Yuan, jako waluta drugiej gospodarki świata. Waluta ta jest o tyle ciekawe, że jest odgórnie sterowana przez rząd Chińskiej Republiki Ludowej.
Currency_Exchange_Rates_DF <- data.frame(Currency_Exchange_Rates) %>%
select(Date, Chinese.Yuan) %>%
group_by(substr(Date, 0,4)) %>%
summarize( Chinese.Yuan = mean(Chinese.Yuan, na.rm=TRUE))
colnames(Currency_Exchange_Rates_DF) <- c("Year", "Yuan")
Currency_Exchange_Rates_DF$Yuan <- na.approx(Currency_Exchange_Rates_DF$Yuan)
ggplot(Currency_Exchange_Rates_DF, aes(x=Year, y=Yuan, group=1)) +
geom_line(aes(group=1)) +
geom_point() +
labs(x = "Rok", y = "Wartość Yuan do USD") +
scale_x_discrete(breaks=seq(1995, 2020, 5)) +
theme_minimal()
Zbiór obejmuje 201 krajów i 7 kategorii zamożności, do których klasyfikują się poszczególne kraje. Zbiór jest opisany w trzech wymiarach: Rok, Kraj, współczynniki dobrobytu.
Zbiór został poddany transpozycji, oraz sprowadzony do dwóch wymiarów, poprzez wybranie Stanów Zjednoczonych jako największej gospodarki świata.
Kategorie, które są w części puste nie zostaną poddane analizie ze względu na brak danych. Po odfiltrowaniu atrybutów zawierających wartości puste otrzymujemy 125 kolumn.
USA_Indicators_DF <- data.frame(World_Development_Indicators) %>%
filter(Country.Name %in% c("United States")) %>%
subset(select = -c(Country.Name, Country.Code, Series.Code))
USA_Indicators_DF[USA_Indicators_DF == ".."] <- NA
USA_Indicators_DF = setNames(data.frame(t(USA_Indicators_DF[,-1])), USA_Indicators_DF[,1])
USA_Indicators_DF <- cbind(rownames(USA_Indicators_DF), USA_Indicators_DF)
rownames(USA_Indicators_DF) <- NULL
colnames(USA_Indicators_DF)[1] <- "Year"
USA_Indicators_DF <- USA_Indicators_DF %>%
mutate(Year = substr(Year, 2, 5)) %>%
filter(Year >= 1995) %>%
filter(Year <= 2018)
USA_Indicators_DF <- data.frame(lapply(USA_Indicators_DF,as.numeric))
na_sum <- data.frame(colSums(is.na(USA_Indicators_DF)))
interesting_USA_Indicators_DF <- USA_Indicators_DF[,na_sum == 0]
amount_chart <- na_sum %>%
mutate(Na.Amount = colSums.is.na.USA_Indicators_DF..) %>%
group_by(Na.Amount) %>%
count(Na.Amount)
ggplot(amount_chart, aes(x=Na.Amount, y=n)) +
geom_bar(stat="identity") +
labs(x="Liczba warości pustych", y="Liczba atrybutów") +
scale_x_continuous(breaks=seq(0, 26, 2)) +
scale_y_continuous(breaks=seq(0, 150, 25)) +
theme_minimal()
Z wykresu można zaobserwować, że występuje dużo ciemnych, czerwonych i niebieskich plam sygnalizujących dużą korelację. Gdy weźmiemy mniejszą próbkę możemy zaobserwować, że zbiór posiada atrybuty, które są od siebie w sposób oczywisty zależne, jak przykładowo liczba mieszkańców ogólnie i liczba kobiet/mężczyzn w Stanach Zjednoczonych.
Aby poradzić sobie z zależnymi atrybutami wykorzystane zostaną te najbardziej ogólne:
Zbiór opisuje właściwości indeksu S&P Composite. Zbiór został pogrupowany względem roku, a z wartości wyciągnięto średnią. Wartości puste zostały pominięte.
SP_Composite_DF <- data.frame(SP_Composite) %>%
mutate(Year = as.numeric(substr(Year, 0, 4))) %>%
filter(Year >= 1995) %>%
filter(Year <= 2018) %>%
group_by(Year) %>%
summarize(S.P.Composite = mean(S.P.Composite, na.rm=TRUE),
Dividend = mean(Dividend),
Earnings = mean(Earnings, na.rm=TRUE),
CPI = mean(CPI, na.rm=TRUE),
Long.Interest.Rate = mean(Long.Interest.Rate, na.rm=TRUE),
Real.Price = mean(Real.Price),
Real.Dividend = mean(Real.Dividend),
Real.Earnings = mean(Real.Earnings),
Cyclically.Adjusted.PE.Ratio = mean(Cyclically.Adjusted.PE.Ratio, na.rm=TRUE)
)
chart_SP_Composite <- SP_Composite_DF %>% pivot_longer(2:10) %>% filter(!is.na(value))
ggplot( chart_SP_Composite , aes(x=Year, y=value)) +
geom_line(aes(group=1)) +
geom_point() +
facet_wrap(name ~ ., scales="free", ncol = 3) +
scale_x_discrete(breaks=seq(1995, 2020, 5)) +
theme_minimal()
SP_Composite_DF <- SP_Composite_DF %>%
select(Year,
SP.Composite.CPI = CPI,
SP.Composite.Cyclically.Adjusted.PE.Ratio = Cyclically.Adjusted.PE.Ratio,
SP.Composite.Earnings = Earnings,
SP.Composite.Long.Interest.Rate = Long.Interest.Rate,
S.P.Composite = S.P.Composite
)
Na wykresach zostały zaprezentowane dostępne atrybuty zbioru. Można na jego podstawie wywnioskować, że S.P.Composite, Ral.Price, Dividend, i Real.Dividend mają podobny kształt. Tak samo Earnings i Real.Earnings.
W dalszej analizie pominiemy atrybuty Real.Price, Dividend, Real.Dividen oraz Real.Earnings.
Interpretacja wskaźników:
Ponieważ cena złota jest wyrażona w różnych walutach, to na potrzeby analizy przyjęta zosatnie cena złota wyrażana w dolarach. Dodatkowo przyjmiemy średnią z notowania porannego i wieczornego.
Gold_prices_DF <- data.frame(Gold_prices) %>%
mutate(Year = substr(Date, 0, 4)) %>%
filter(Year >= 1995) %>%
filter(Year <= 2018) %>%
group_by(Year) %>%
summarize( USD = (mean(USD..AM., na.rm=TRUE) + mean(USD..PM., na.rm=TRUE))/2)
colnames(Gold_prices_DF) <- c("Year", "Gold_Price_USD")
ggplot(Gold_prices_DF, aes(x=Year, y=Gold_Price_USD, group=1)) +
geom_line(aes(group=1)) +
geom_point() +
labs(x = "Rok", y = "Cena złota [USD]") +
scale_x_discrete(breaks=seq(1995, 2020, 5)) +
theme_minimal()
Do analizy wykorzystamy średnie wartości atrybutów bitcoina w ciągu roku. Lata przed 2009 otrzymają wartość 0.
Dostępne pliki:
mock_Bitcoin_mkpru_DF <- data.frame(c(1995:2009), 0)
clean_bitcoin <- function(data, name) {
clean <- data.frame(data) %>%
mutate(Year = substr(Date, 0, 4)) %>%
filter(Year >= 1995) %>%
filter(Year <= 2018) %>%
group_by(Year) %>%
summarize(Value = (mean(Value)))
colnames(clean) <- c("Year", name)
names(mock_Bitcoin_mkpru_DF) <- names(clean)
clean <- rbind(clean, mock_Bitcoin_mkpru_DF)
}
Bitcoin_mkpru_DF <- clean_bitcoin(Bitcoin_mkpru, "Bitcoin_Price")
Bitcoin_diff_DF <- clean_bitcoin(Bitcoin_diff, "Bitcoin_Difficult")
Bitcoin_hrate_DF <- clean_bitcoin(Bitcoin_hrate, "Bitcoin_Hash")
Bitcoin_trvou_DF <- clean_bitcoin(Bitcoin_trvou, "Bitcoin_Total_Value")
bitcoin1 <- merge(Bitcoin_mkpru_DF, Bitcoin_diff_DF)
bitcoin2 <- merge(Bitcoin_hrate_DF, Bitcoin_trvou_DF)
bitcoin <- merge(bitcoin1, bitcoin2)
chart_bitcoin <- bitcoin %>% pivot_longer(2:5) %>% filter(!is.na(value))
ggplot( chart_bitcoin , aes(x=Year, y=value)) +
geom_line(aes(group=1)) +
geom_point() +
facet_wrap(name ~ ., scales="free", ncol = 2) +
scale_x_discrete(breaks=seq(1995, 2020, 5)) +
theme_minimal()
Z zaprezentowanych powyżej wykresów można zaobserwować, że wszystkie 4 wartości są od siebie zależne. Na potrzeby dalszych analiz skorzystamy z atrybutu ceny bitcoina.
df1 <- merge(Currency_Exchange_Rates_DF, general_USA_Indicators_DF)
df2 <- merge(Gold_prices_DF, Bitcoin_mkpru_DF)
df3 <- merge(df2, SP_Composite_DF)
df <- merge(df1, df3)
Poniższy wykres przedstawia wartość współczynnika korelacji Pearsona między parametrami atrybutów w zbiorze.
Poniższa tabela prezentuje 20 par atrybutów z największym współczynnikiem korelacji Pearsona.
| rowname | colname | value |
|---|---|---|
| Population..total | Urban.population | 0.9998361 |
| Population..total | SP.Composite.CPI | 0.9967195 |
| SP.Composite.CPI | Urban.population | 0.9957596 |
| GDP.per.capita..current.US.. | Urban.population | 0.9918233 |
| GDP.per.capita..current.US.. | Population..total | 0.9909770 |
| GDP.per.capita..current.US.. | SP.Composite.CPI | 0.9907750 |
| Gold_Price_USD | Yuan | -0.9611509 |
| Population..total | SP.Composite.Long.Interest.Rate | -0.9490566 |
| SP.Composite.Long.Interest.Rate | Urban.population | -0.9472895 |
| SP.Composite.CPI | SP.Composite.Long.Interest.Rate | -0.9409388 |
| CO2.emissions..metric.tons.per.capita. | Yuan | 0.9370947 |
| CO2.emissions..metric.tons.per.capita. | SP.Composite.CPI | -0.9276107 |
| CO2.emissions..metric.tons.per.capita. | Gold_Price_USD | -0.9267564 |
| SP.Composite.CPI | Yuan | -0.9241426 |
| CO2.emissions..metric.tons.per.capita. | Population..total | -0.9158413 |
| CO2.emissions..metric.tons.per.capita. | Urban.population | -0.9129727 |
| GDP.per.capita..current.US.. | SP.Composite.Long.Interest.Rate | -0.9111305 |
| Population..total | Yuan | -0.9050637 |
| CO2.emissions..metric.tons.per.capita. | GDP.per.capita..current.US.. | -0.9018189 |
| CO2.emissions..metric.tons.per.capita. | SP.Composite.Long.Interest.Rate | 0.9008162 |
Interpretacja wybranych korelacji:
Ostateczny zbiór poddany analizie zawiera 12 atrybutów i 25 obserwacji.
options(knitr.kable.NA = '')
knitr::kable(summary(df[1:6]))
| Year | Yuan | Urban.population | Population..total | Inflation..consumer.prices..annual… | GDP.per.capita..current.US.. | |
|---|---|---|---|---|---|---|
| Length:25 | Min. :6.143 | Min. :205718394 | Min. :266278000 | Min. :-0.3555 | Min. :28691 | |
| Class :character | 1st Qu.:6.644 | 1st Qu.:225792302 | 1st Qu.:284968955 | 1st Qu.: 1.5860 | 1st Qu.:37133 | |
| Mode :character | Median :7.606 | Median :241795278 | Median :301231207 | Median : 2.2701 | Median :47100 | |
| Mean :7.406 | Mean :239857040 | Mean :299146527 | Mean : 2.1223 | Mean :45093 | ||
| 3rd Qu.:8.277 | 3rd Qu.:254614421 | 3rd Qu.:313877662 | 3rd Qu.: 2.8527 | 3rd Qu.:51603 | ||
| Max. :8.374 | Max. :268844029 | Max. :326838199 | Max. : 3.8391 | Max. :63064 |
knitr::kable(summary(df[7:12]))
| CO2.emissions..metric.tons.per.capita. | Gold_Price_USD | Bitcoin_Price | SP.Composite.CPI | SP.Composite.Cyclically.Adjusted.PE.Ratio | SP.Composite.Earnings | |
|---|---|---|---|---|---|---|
| Min. :14.81 | Min. : 271.1 | Min. : 0.000 | Min. :152.4 | Min. :16.92 | Min. : 16.46 | |
| 1st Qu.:16.10 | 1st Qu.: 363.6 | 1st Qu.: 0.000 | 1st Qu.:177.1 | 1st Qu.:22.72 | 1st Qu.: 36.28 | |
| Median :18.96 | Median : 695.9 | Median : 0.000 | Median :207.3 | Median :25.98 | Median : 55.30 | |
| Mean :18.03 | Mean : 798.1 | Mean : 524.623 | Mean :202.6 | Mean :26.70 | Mean : 61.58 | |
| 3rd Qu.:19.60 | 3rd Qu.:1250.3 | 3rd Qu.: 8.474 | 3rd Qu.:229.6 | 3rd Qu.:29.85 | 3rd Qu.: 87.40 | |
| Max. :20.47 | Max. :1668.9 | Max. :7571.679 | Max. :251.1 | Max. :42.07 | Max. :123.30 |
Wielkość punktu reprezentuje cenę złota w USD.
Z poniższego wykresu w początkowej fazie można zaobserwować, że zmiana ceny indeksu bez dużych odchyleń kursu Yuan miała negatywny wpływ na wzrost ceny złota. Widać również, że cena złota osiągała swoje największe wartości przy niskim kursie Yuan. Można wysunąć wnioski, że wzrost cena indeksu ma największy wpływ na wzrost ceny złota, gdy kurs Yuan jest niski. Wyższy kursu Yuan niweluje korelację miedzy wzrostem ceny indeksu, a złota.
Niniejsza sekcja opisuje proces tworzenia regresora, którego zadaniem jest przewidywanie ceny złota. Ze względu na uniwersalność zostanie wykorzystany algorytm Random Forest z wykorzystaniem powtórzonej metody krzyżowej.
set.seed(23)
reggresion_df <- df %>% mutate(Year = as.numeric(Year))
inTraining <- createDataPartition( y = reggresion_df$Gold_Price_USD, p=0.7, list=F)
training <- reggresion_df[ inTraining,]
testing <- reggresion_df[-inTraining,]
rfGrid <- expand.grid(mtry = 10:40)
ctrl <- trainControl(
method = "repeatedcv",
number = 2,
repeats = 5)
modelWithRepeateDCV <- train(Gold_Price_USD ~ .,
data = training,
method = "rf",
trControl = ctrl,
tuneGrid = rfGrid,
ntree = 30
)
modelWithRepeateDCV
## Random Forest
##
## 20 samples
## 13 predictors
##
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times)
## Summary of sample sizes: 9, 11, 10, 10, 11, 9, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 10 167.1159 0.8966315 125.6160
## 11 172.4007 0.9169301 132.9080
## 12 167.9270 0.9075528 127.7618
## 13 177.0673 0.8884651 134.3187
## 14 161.6143 0.9080524 115.2145
## 15 161.8744 0.9094911 118.5018
## 16 155.0683 0.9116919 109.8805
## 17 166.3346 0.9061880 125.8197
## 18 168.7704 0.9093927 124.0229
## 19 159.5520 0.9142157 117.7575
## 20 162.9517 0.9220279 124.4474
## 21 166.8032 0.9095717 125.6785
## 22 162.1774 0.9072350 122.5412
## 23 171.6937 0.9046506 133.6396
## 24 162.6550 0.9111316 123.4015
## 25 167.5727 0.9029774 123.0157
## 26 177.1461 0.9033477 136.8577
## 27 171.2559 0.9074119 127.8359
## 28 170.6456 0.9009481 132.9828
## 29 180.8778 0.8718582 134.4795
## 30 154.3314 0.9105202 118.1549
## 31 167.8113 0.9041138 128.0316
## 32 166.0995 0.9124326 128.9577
## 33 158.2379 0.9136072 119.5309
## 34 161.1662 0.9133076 119.1108
## 35 173.8650 0.8949480 131.9702
## 36 177.1124 0.8837425 137.0058
## 37 166.1415 0.9103237 127.0416
## 38 165.8696 0.9025346 123.1629
## 39 161.4952 0.9117590 119.4399
## 40 171.0210 0.8990625 131.1632
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 30.
Najlepszy model został stworzony dla parametru mtry (liczba zmiennych losowo wybranych jako kandydaci w każdym podziale) równego 30. Błąd średniokwadratowy (RMSE) dla tego modelu jest najmniejszy i wynosi 154.3314. Patrząc na powyższą tabelkę można też zauważyć, że Rsquared (miara dopasowania modelu do danych) jest jednym z wyższych, co pozwala upewnić się w wyborze.
rfWithRepeateDCV <- predict(modelWithRepeateDCV, newdata = testing)
Poniższy wykres prezentuje wartości sugerowane przez model, oraz prawdziwe.
plot_df <- testing %>% select(Year, Gold_Price_USD)
plot_df$Predicted <- rfWithRepeateDCV
ggplot(plot_df, aes(x=Year)) +
geom_line(aes(y = Gold_Price_USD, color = "Rzeczywista cena złota"), size=1) +
geom_line(aes(y = Predicted, color="Cena obliczona przez model"), size=1) +
labs(x = "Rok", y = "Cena złota [USD]") +
theme_minimal() +
scale_color_manual(name = "Legenda", values = c("Rzeczywista cena złota" = "darkred", "Cena obliczona przez model" = "steelblue"))
importance(modelWithRepeateDCV$finalModel)
## IncNodePurity
## Year 559168.16
## Yuan 726380.44
## Urban.population 460226.46
## Population..total 519506.84
## Inflation..consumer.prices..annual... 128079.85
## GDP.per.capita..current.US.. 40564.86
## CO2.emissions..metric.tons.per.capita. 315392.10
## Bitcoin_Price 231268.00
## SP.Composite.CPI 138877.86
## SP.Composite.Cyclically.Adjusted.PE.Ratio 40819.13
## SP.Composite.Earnings 246545.03
## SP.Composite.Long.Interest.Rate 527352.27
## S.P.Composite 32347.29
Najważniejszym atrybutem przy wyborze regresji są: